home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / sswap.f < prev   
Text File  |  1989-08-17  |  4KB  |  110 lines
  1. c   imsl routine name   - vbla=sswap                                    vbsn0010
  2. c
  3. c-----------------------------------------------------------------------
  4. c
  5. c   computer            - vax/single
  6. c
  7. c   latest revision     - january 1, 1978
  8. c
  9. c   purpose             - interchange vectors x and y, both
  10. c                           single precision
  11. c
  12. c   usage               - call sswap (n,sx,incx,sy,incy)
  13. c
  14. c   arguments    n      - length of vectors x and y. (input)
  15. c                sx     - real vector of length max(n*iabs(incx),1).
  16. c                           (input/output)
  17. c                           sswap interchanges x(i) and y(i) for
  18. c                           i=1,...,n.
  19. c                           x(i) and y(i) refer to specific elements
  20. c                           of sx and sy, respectively. see incx and
  21. c                           incy argument descriptions.
  22. c                incx   - displacement between elements of sx. (input)
  23. c                           x(i) is defined to be..
  24. c                           sx(1+(i-1)*incx) if incx.ge.0 or
  25. c                           sx(1+(i-n)*incx) if incx.lt.0.
  26. c                sy     - real vector of length max(n*iabs(incy),1).
  27. c                           (input/output)
  28. c                incy   - displacement between elements of sy. (input)
  29. c                           y(i) is defined to be..
  30. c                           sy(1+(i-1)*incy) if incy.ge.0 or
  31. c                           sy(1+(i-n)*incy) if incy.lt.0.
  32. c
  33. c   precision/hardware  - single/all
  34. c
  35. c   reqd. imsl routines - none required
  36. c
  37. c   notation            - information on special notation and
  38. c                           conventions is available in the manual
  39. c                           introduction or through imsl routine uhelp
  40. c
  41. c   copyright           - 1978 by imsl, inc. all rights reserved.
  42. c
  43. c   warranty            - imsl warrants only that imsl testing has been
  44. c                           applied to this code. no other warranty,
  45. c                           expressed or implied, is applicable.
  46. c
  47. c-----------------------------------------------------------------------
  48. c
  49.       subroutine sswap  (n,sx,incx,sy,incy)
  50. c
  51. c                                  specifications for arguments
  52.       integer            n,incx,incy
  53.       real               sx(1),sy(1)
  54. c                                  specifications for local variables
  55.       integer            i,ix,iy,m,mp1,ns
  56.       real               stemp1,stemp2,stemp3
  57. c                                  first executable statement
  58.       if (n.le.0) return
  59.       if (incx.eq.incy) if (incx-1) 5,15,35
  60.     5 continue
  61. c                                  code for unequal or nonpositive
  62. c                                    increments.
  63.       ix = 1
  64.       iy = 1
  65.       if (incx.lt.0) ix = (-n+1)*incx+1
  66.       if (incy.lt.0) iy = (-n+1)*incy+1
  67.       do 10 i=1,n
  68.          stemp1 = sx(ix)
  69.          sx(ix) = sy(iy)
  70.          sy(iy) = stemp1
  71.          ix = ix+incx
  72.          iy = iy+incy
  73.    10 continue
  74.       return
  75. c                                  code for both increments equal to 1
  76. c                                    clean-up loop so remaining vector
  77. c                                    length is a multiple of 3.
  78.    15 m = n-(n/3)*3
  79.       if (m.eq.0) go to 25
  80.       do 20 i=1,m
  81.          stemp1 = sx(i)
  82.          sx(i) = sy(i)
  83.          sy(i) = stemp1
  84.    20 continue
  85.       if (n.lt.3) return
  86.    25 mp1 = m+1
  87.       do 30 i=mp1,n,3
  88.          stemp1 = sx(i)
  89.          stemp2 = sx(i+1)
  90.          stemp3 = sx(i+2)
  91.          sx(i) = sy(i)
  92.          sx(i+1) = sy(i+1)
  93.          sx(i+2) = sy(i+2)
  94.          sy(i) = stemp1
  95.          sy(i+1) = stemp2
  96.          sy(i+2) = stemp3
  97.    30 continue
  98.       return
  99.    35 continue
  100. c                                  code for equal, positive, nonunit
  101. c                                    increments.
  102.       ns = n*incx
  103.       do 40 i=1,ns,incx
  104.          stemp1 = sx(i)
  105.          sx(i) = sy(i)
  106.          sy(i) = stemp1
  107.    40 continue
  108.       return
  109.       end
  110.